home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / w3 / w3-imap.el.z / w3-imap.el
Encoding:
Text File  |  1998-05-21  |  7.1 KB  |  228 lines
  1. ;;; w3-imap.el --- Imagemap functions
  2. ;; Author: wmperry
  3. ;; Created: 1997/10/17 14:08:16
  4. ;; Version: 1.8
  5. ;; Keywords: hypermedia
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;; Copyright (c) 1996 by William M. Perry <wmperry@cs.indiana.edu>
  9. ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
  10. ;;;
  11. ;;; This file is part of GNU Emacs.
  12. ;;;
  13. ;;; GNU Emacs is free software; you can redistribute it and/or modify
  14. ;;; it under the terms of the GNU General Public License as published by
  15. ;;; the Free Software Foundation; either version 2, or (at your option)
  16. ;;; any later version.
  17. ;;;
  18. ;;; GNU Emacs is distributed in the hope that it will be useful,
  19. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ;;; GNU General Public License for more details.
  22. ;;;
  23. ;;; You should have received a copy of the GNU General Public License
  24. ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25. ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26. ;;; Boston, MA 02111-1307, USA.
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28.  
  29. (require 'w3-vars)
  30. (eval-and-compile
  31.   (require 'widget))
  32.  
  33. (eval-when-compile
  34.   (defmacro x-coord (pt) (list 'aref pt 0))
  35.   (defmacro y-coord (pt) (list 'aref pt 1)))
  36.  
  37. (defun w3-point-in-rect (point coord1 coord2 &rest ignore)
  38.   "Return t iff POINT is within a rectangle defined by COORD1 and COORD2.
  39. All arguments are vectors of [X Y] coordinates."
  40.   ;; D'uhhh, this is hard.
  41.   (and (>= (x-coord point) (x-coord coord1))
  42.        (<= (x-coord point) (x-coord coord2))
  43.        (>= (y-coord point) (y-coord coord1))
  44.        (<= (y-coord point) (y-coord coord2))))
  45.  
  46. (defun w3-point-in-circle (point coord1 coord2 &rest ignore)
  47.   "Return t iff POINT is within a circle defined by COORD1 and COORD2.
  48. All arguments are vectors of [X Y] coordinates."
  49.   ;; D'uhhh, this is (barely) slightly harder.
  50.   (let (radius1 radius2)
  51.     (setq radius1 (+
  52.            (*
  53.             (- (y-coord coord1) (y-coord coord2))
  54.             (- (y-coord coord1) (y-coord coord2)))
  55.            (*
  56.             (- (x-coord coord1) (x-coord coord2))
  57.             (- (x-coord coord1) (x-coord coord2)))
  58.            )
  59.       radius2 (+
  60.            (*
  61.             (- (y-coord coord1) (y-coord point))
  62.             (- (y-coord coord1) (y-coord point)))
  63.            (*
  64.             (- (x-coord coord1) (x-coord point))
  65.             (- (x-coord coord1) (x-coord point)))
  66.            )
  67.       )
  68.     (<= radius2 radius1)))
  69.  
  70. ;; A polygon is a vector
  71. ;; poly[0] = # of sides
  72. ;; poly[1] = # of sides used
  73. ;; poly[2] = vector of X coords
  74. ;; poly[3] = vector of Y coords
  75.  
  76. (defsubst w3-image-poly-nsegs (p)
  77.   (aref p 0))
  78.  
  79. (defsubst w3-image-poly-used-segs (p)
  80.   (aref p 1))
  81.  
  82. (defsubst w3-image-poly-x-coords (p)
  83.   (aref p 2))
  84.  
  85. (defsubst w3-image-poly-y-coords (p)
  86.   (aref p 3))
  87.  
  88. (defsubst w3-image-poly-x-coord (p n)
  89.   (aref (w3-image-poly-x-coords p) n))
  90.  
  91. (defsubst w3-image-poly-y-coord (p n)
  92.   (aref (w3-image-poly-y-coords p) n))
  93.  
  94. (defun w3-image-poly-alloc (n)
  95.   (if (< n 3)
  96.       (error "w3-image-poly-alloc: invalid number of sides (%d)" n))
  97.   
  98.   (vector n 0 (make-vector n nil) (make-vector n nil)))
  99.  
  100. (defun w3-image-poly-assign (p x y)
  101.   (if (>= (w3-image-poly-used-segs p) (w3-image-poly-nsegs p))
  102.       (error "w3-image-poly-assign: out of space in the w3-image-polygon"))
  103.   (aset (w3-image-poly-x-coords p) (w3-image-poly-used-segs p) x)
  104.   (aset (w3-image-poly-y-coords p) (w3-image-poly-used-segs p) y)
  105.   (aset p 1 (1+ (w3-image-poly-used-segs p))))
  106.  
  107. (defun w3-image-ccw (p0 p1 p2)
  108.   (let (dx1 dx2 dy1 dy2 retval)
  109.     (setq dx1 (- (x-coord p1) (x-coord p0))
  110.       dy1 (- (y-coord p1) (y-coord p0))
  111.       dx2 (- (x-coord p2) (x-coord p0))
  112.       dy2 (- (y-coord p2) (y-coord p0)))
  113.     (cond
  114.      ((> (* dx1 dy2) (* dy1 dx2))
  115.       (setq retval 1))
  116.      ((< (* dx1 dy2) (* dy1 dx2))
  117.       (setq retval -1))
  118.      ((or (< (* dx1 dx2) 0)
  119.       (< (* dy1 dy2) 0))
  120.       (setq retval -1))
  121.      ((< (+ (* dx1 dx1) (* dy1 dy1))
  122.      (+ (* dx2 dx2) (* dy2 dy2)))
  123.       (setq retval 1))
  124.      (t
  125.       (setq retval 0)))
  126.     retval))
  127.  
  128. (defun w3-image-line-intersect (l1 l2)
  129.   (and (<= (* (w3-image-ccw (car l1) (cdr l1) (car l2))
  130.           (w3-image-ccw (car l1) (cdr l1) (cdr l2))) 0)
  131.        (<= (* (w3-image-ccw (car l2) (cdr l2) (car l1))
  132.           (w3-image-ccw (car l2) (cdr l2) (cdr l1))) 0)))
  133.  
  134. (defun w3-point-in-poly (point &rest pgon)
  135.   "Return t iff POINT is within a polygon defined by the list of points PGON.
  136. All arguments are either vectors of [X Y] coordinates or lists of such
  137. vectors."
  138.   ;; Right now, this fails on some points that are right on a line segment
  139.   ;; but it works for everything else (I think)
  140.   (if (< (length pgon) 3)
  141.       ;; Malformed polygon!!!
  142.       nil
  143.     (let ((p (w3-image-poly-alloc (length pgon)))
  144.       (hitcount 0)
  145.       (i 0)
  146.       (ip1 0)
  147.       (l1 nil)
  148.       (l2 (cons (vector (x-coord point) (1+ (y-coord point)))
  149.             (vector (x-coord point) (y-coord point))))
  150.       )
  151.       (while pgon
  152.     (w3-image-poly-assign p (x-coord (car pgon)) (y-coord (car pgon)))
  153.     (setq pgon (cdr pgon)))
  154.       (while (< i (w3-image-poly-nsegs p))
  155.     ;; Check for wraparound
  156.     (setq ip1 (1+ i))
  157.     (if (= ip1 (w3-image-poly-nsegs p))
  158.         (setq ip1 0))
  159.  
  160.     (setq l1 (cons (vector (w3-image-poly-x-coord p i)
  161.                    (w3-image-poly-y-coord p i))
  162.                (vector (w3-image-poly-x-coord p ip1)
  163.                    (w3-image-poly-y-coord p ip1))))
  164.  
  165.     (if (w3-image-line-intersect l1 l2)
  166.         (setq hitcount (1+ hitcount)))
  167.     (setq i (1+ i)))
  168.       (= 1 (% hitcount 2)))))
  169.  
  170. (defun w3-point-in-default (point &rest ignore)
  171.   t)
  172.  
  173. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  174.  
  175. (defun w3-point-in-map (point map &optional alt-text)
  176.   (let (func args done cur default slot)
  177.     (setq slot (if alt-text 3 2))
  178.     (while (and map (not done))
  179.       (setq cur (car map)
  180.         func (intern-soft (format "w3-point-in-%s" (aref cur 0)))
  181.         args (aref cur 1)
  182.         done (and func (fboundp func) (apply func point args))
  183.         map (cdr map))
  184.       (if (equal (aref cur 0) "default")
  185.       (setq default (aref cur slot)
  186.         done nil)))
  187.     (cond
  188.      ((and done (aref cur 2)) ; Found a link
  189.       (if alt-text
  190.       (or (aref cur 3) (aref cur 2))
  191.     (aref cur slot)))
  192.      (default
  193.        default)
  194.      (t nil))))
  195.  
  196.  
  197. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  198. ;;; Regular image stuff
  199. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  200. (defvar w3-allowed-image-types
  201.   (mapcar (function (lambda (x) (list (car x)))) w3-image-mappings))
  202. (defvar w3-image-size-restriction nil)
  203.  
  204. (defmacro w3-image-cached-p (href)
  205.   "Return non-nil iff HREF is in the image cache."
  206.   (` (cdr-safe (assoc (, href) w3-graphics-list))))
  207.  
  208. (defun w3-image-loadable-p (href force)
  209.   (let ((attribs (url-file-attributes href)))
  210.     (or force
  211.     (assoc (nth 8 attribs) w3-allowed-image-types)
  212.     (null w3-image-size-restriction)
  213.     (<= (nth 7 attribs) 0)
  214.     (and (numberp w3-image-size-restriction)
  215.          (<= (nth 7 attribs) w3-image-size-restriction)))))
  216.  
  217. (defmacro w3-image-invalid-glyph-p (glyph)
  218.   (` (or (null (aref (, glyph) 0))
  219.      (null (aref (, glyph) 2))
  220.      (equal (aref (, glyph) 2) ""))))
  221.  
  222. ;; data structure in storage is a vector
  223. ;; if (href == t) then no action should be taken
  224. ;; [ type coordinates href (hopefully)descriptive-text]
  225.  
  226.  
  227. (provide 'w3-imap)
  228.